home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TIMING.SWG / 0005_Calculate Program Time.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  117 lines
  1. { SB> Has anyone by any chance written a Procedure For calculating the amount
  2.  SB> of time a Program runs.  I understand how to use getTime, etc, but I am
  3.  SB> trying to figure out a way around all the possibilities...i.e. someone
  4.  SB> starts a Program at 23:59:03.44, and it's finished at 00:02:05.33.
  5.  SB>
  6.  SB> Anyway, if someone already has this figured out, I'd sure appreciate it
  7.  SB> or even some ideas...
  8.  
  9. Scott,
  10.     try:
  11.  
  12.     Var
  13.         Timer : LongInt Absolute $0040:$006c;
  14.  
  15.     That's the Tic counter, stored at Segment 0040h, offset 006Ch. It
  16. stores the number of ticks since you turned the Computer on and so will
  17. only wrap after MorE THAN 3 YEARS, if you never close the machine ;-)
  18.  
  19.     it is incremented 18.2 times/sec, so divide it by 18.2 to get the
  20. number of seconds. You can figure out the rest ;-)
  21.  
  22.     Store its content to another LongInt at the start of the Program,
  23. again at the end. Substract the first value from the second and you have
  24. the number of ticks elapsed during the Program's execution.
  25.  
  26. Oh what the heck, here is a Complete Unit, all you have to do is include
  27. it in your Uses clause nothing more unless you want to save the time in
  28. a log File or something.
  29. }
  30.  
  31. {$A+,B-,D+,E-,F+,G+,I-,L+,N-,O+,P+,Q-,R-,S-,T-,V-,X+,Y+}
  32. {$M 8192,0,0}
  33. Unit TimePrg;
  34. (**) Interface (**)
  35. (**) Implementation (**)
  36. Uses
  37.   Dos;
  38. Type
  39.   CmdLine = String[127];
  40. Var
  41.   TimerTicks : LongInt Absolute $0040:$006C;
  42.   OldCommandLine, NewCommandline : CmdLine;
  43.   CommandLine : ^CmdLine;
  44.   TimeIn, TimeOut, Spent : LongInt;
  45.   Years, Days, Hours, Minutes, Seconds, ms : Byte;
  46.   ExitBeForeTimePrg : Pointer;
  47.   D : DirStr;
  48.   N : NameStr;
  49.   E : ExtStr;
  50.   Index : Integer;
  51.  
  52. Function Strfunc(Value:Byte):String;
  53. Var
  54.   temp : String;
  55. begin
  56.   Str(Value:0, Temp);
  57.   StrFunc := #32+temp;
  58. end;
  59.  
  60. Procedure TimePrgExit; Far;
  61. begin
  62.   TimeOut := TimerTicks;
  63.   ExitProc := ExitBeForeTimePrg;
  64.   Spent := TimeOut - TimeIn;
  65.   ms := (Spent - trunc(Spent / 18.2))*55;
  66.   Spent := Trunc(Spent / 18.2);
  67.   Years := Spent div (3600*24*365);
  68.   Spent := Spent mod (3600*24*365);
  69.   Days := Spent div (3600*24);
  70.   Spent := Spent mod (3600*24);
  71.   Hours := Spent div 3600;
  72.   Spent := Spent mod 3600;
  73.   Minutes := Spent div 60;
  74.   Spent := Spent mod 60;
  75.   Seconds := Spent;
  76.   CommandLine := Ptr(PrefixSeg, $80);
  77.   OldCommandLine := CommandLine^;
  78.   NewCommandLine := '';
  79.   if Years>0 then
  80.     NewCommandLine := NewCommandLine + Strfunc(Years) + ' Years';
  81.   if Days>0 then
  82.     NewCommandLine := NewCommandLine + Strfunc(Days) + ' Days';
  83.   if Hours>0 then
  84.     NewCommandLine := NewCommandLine + Strfunc(Hours) + ' Hours';
  85.   if Minutes>0 then
  86.     NewCommandLine := NewCommandLine + Strfunc(Minutes) + ' Minutes';
  87.   if Seconds>0 then
  88.     NewCommandLine := NewCommandLine + Strfunc(Seconds)        + ' Seconds';
  89.   if ms>0 then
  90.     NewCommandLine := NewCommandLine + Strfunc(ms) + ' milli-seconds';
  91.   CommandLine^ := NewCommandLine;
  92.   Write('Thanks For spending ');
  93.   Case Paramcount of
  94.     0: Write('so little time');
  95.     2: Write(ParamStr(1),#32, Paramstr(2));
  96.   else
  97.     For Index := 1 to ParamCount - 3 do begin
  98.       Write(Paramstr(Index));
  99.       if odd(Index) then
  100.         Write(' ')
  101.       else
  102.         Write(', ');
  103.     end;
  104.     Write(Paramstr(Index+1), ' and ',
  105.     Paramstr(Index+2), ' ', Paramstr(Index+3));
  106.   end;
  107.   CommandLine^ := OldCommandLine;
  108.   Fsplit(Paramstr(0), D, N, E);
  109.   Writeln(' In ', N);
  110. end;
  111.  
  112. begin
  113.   TimeIn := TimerTicks;
  114.   ExitBeForeTimePrg := ExitProc;
  115.   ExitProc := @TimePrgExit;
  116. end.
  117.